home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / prog_gen / janusw.zip / DLGTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-16  |  19KB  |  598 lines
  1. { Program:   DlgTest
  2.   Version:   1.30
  3.   Purpose:   demonstrates tDialogWindow as modeless Dialog Windows and
  4.              MDI child windows.
  5.              For a simpler demo of tDialogWindows as MDI children see file MinMdi.Pas
  6.   Features:  - creates a standard Dialog from BorDlg resource
  7.              - creates a BorDlg from standard resource
  8.              - creates Dialog as is
  9.              - demonstrates the use of "non-standard" MDI child styles
  10.                under Windows 3.1
  11.   Uses:      BWCC.DLL, CTL3D.DLL and BIVBX10.DLL if present.
  12.  
  13.   Developer: Peter Sawatzki (ps)
  14.              Buchenhof 3, D58091 Hagen, Germany
  15.  CompuServe: 100031,3002
  16.  
  17.   Date:     Author:
  18.   04/22/92  ps       initial release
  19.   07/25/92  ps/jwp   added Scroller demo
  20.   08/01/92  ps       fixed some bugs, added modal dialog demo
  21.   08/30/92  ps       add MDI/non-MDI menu item
  22.   06/29/93  ps       modified for new tAdvApplication object
  23.   10/01/93  ps       modified for CTL3D
  24.   02/14/93  ps       modified for VBX
  25.  
  26.   Copyright (c) 1994 Peter Sawatzki. All Rights Reserved.
  27. }
  28. program DlgTest;
  29. {$A+,B-,F-,G+,I-,K+,P-,Q-,R-,S-,T-,V-,X+}
  30. {$R DlgTest.Res}
  31. Uses
  32.   Win31,
  33. {$IfDef Debug} Debug, {$EndIf}
  34.   WinTypes,
  35.   WinProcs,
  36.   Strings,
  37.   Objects,
  38.   oWindows,
  39.   oDialogs,
  40.   DynLink,
  41.   Vbx,
  42. {$IfDef PsPrint} PsPrint,
  43. {$Else}          oPrinter, {$EndIf}
  44. {$IfDef Custom}  CustomWn, {$EndIf}
  45. {$IfDef PScc}    PSccTest, {$EndIf}
  46. {$IfDef DEW}     DEWTest,  {$EndIf}
  47.   DialogWn;
  48. {$i DlgTest.Inc}
  49. Const
  50.   VBXvalidation: tVbxValidation = cVbxValidation;
  51.   ProgName = 'DlgTest';
  52.   AppCtl: (MdiApp,NormApp,SwitchApp,TermApp) = MdiApp; {we want a Mdi app first}
  53.   GlobalPosRect: tRect = (left: -1);
  54.  
  55. {-------------------- the tDialogWindow supporting an owner draw listbox }
  56. Type
  57.   pOwnerLBWindow = ^tOwnerLBWindow;
  58.   tOwnerLBWindow = Object(tDialogWindow)
  59.     Procedure SetupWindow; Virtual;
  60.     Procedure wmMeasureItem (Var Msg: tMessage); Virtual wm_First+wm_MeasureItem;
  61.     Procedure wmDrawItem (Var Msg: tMessage);    Virtual wm_First+wm_DrawItem;
  62.     Procedure wmModalClone (Var Msg: tMessage);  Virtual id_First+$100;
  63.   End;
  64.  
  65. Procedure tOwnerLBWindow.SetupWindow;
  66.   Procedure AddLb (aString: pChar);
  67.   Begin
  68.     SendDlgItemMessage(hWindow,10, lb_AddString, 0, LongInt(aString))
  69.   End;
  70. Begin
  71.   Inherited SetupWindow;
  72.   AddLb('This is the'#13'Asterisk Icon symbol loaded'#13+
  73.         'with ''LoadIcon(idi_Asterisk)''');
  74.   AddLb('Exclamation');
  75.   AddLb('Hand');
  76.   AddLb('Question');
  77. End;
  78.  
  79. Procedure tOwnerLBWindow.wmMeasureItem (Var Msg: tMessage);
  80. Var
  81.   aDC: hDC;
  82.   OldFont: hFont;
  83.   CalcRect: tRect;
  84. Begin With pMeasureItemStruct(Msg.lParam)^ Do Begin
  85.   aDC:= GetDC(hWindow);
  86.   OldFont:= SelectObject(aDC, DialogAttr.Font);
  87.   itemHeight:= GetSystemMetrics (SM_CYICON);
  88.   DrawText(aDC, Pointer(itemData), -1, CalcRect, dt_CalcRect);
  89.   With CalcRect Do If itemHeight<bottom-top Then
  90.     itemHeight:= bottom-top;
  91.   SelectObject(aDC, OldFont);
  92.   ReleaseDC(hWindow, aDC)
  93. End End;
  94.  
  95. Procedure tOwnerLBWindow.wmDrawItem (Var Msg: tMessage);
  96. Var
  97.   Tmp: Array[0..150] Of Char;
  98.   anIcon: hIcon;
  99.   TextRect: tRect;
  100.   OldBkColor: tColorRef;
  101.  
  102.     Procedure DrawRedFrame (aDC: hDC; aRect: tRect);
  103.     Var
  104.       OldPen: hPen;
  105.     Begin With aRect Do Begin
  106.       OldPen:= SelectObject(aDC, CreatePen(ps_Dot, 1, $80));
  107.       MoveTo(aDC, left, top); LineTo(aDC, right-1,top); LineTo(aDC,right-1,bottom-1);
  108.       LineTo(aDC,left,bottom-1); LineTo(aDC, left,top);
  109.       DeleteObject(SelectObject(aDC, OldPen))
  110.     End End;
  111.  
  112. Begin With pDrawItemStruct(Msg.lParam)^ Do Begin
  113.   Case itemID Of
  114.     0: anIcon:= LoadIcon(0, idi_Asterisk);
  115.     1: anIcon:= LoadIcon(0, idi_Exclamation);
  116.     2: anIcon:= LoadIcon(0, idi_Hand);
  117.     3: anIcon:= LoadIcon(0, idi_Question);
  118.   Else
  119.     anIcon:= 0
  120.   End;
  121.   SendDlgItemMessage(hWindow,10{id ListBox},lb_GetText,itemID,LongInt(@Tmp));
  122.   If itemState And ODS_Selected=0 Then
  123.     OldBkColor:= SetBkColor(hDC, GetSysColor(Color_Window)) {not selected}
  124.   Else
  125.     If itemState And ODS_Focus=0 Then
  126.       OldBkColor:= SetBkColor(hDC, GetSysColor(Color_BtnFace)) {selected without focus}
  127.     Else
  128.       OldBkColor:= SetBkColor(hDC, GetSysColor(Color_HighLight)); {selected with focus}
  129.   ExtTextOut(hDC, 0, 0, Eto_Opaque, @rcItem, Nil, 0, Nil);
  130.   TextRect:= rcItem; Inc(TextRect.left, GetSystemMetrics(sm_CxIcon)+5);
  131.   DrawText(hDC, Tmp, -1, TextRect, dt_Left Or dt_VCenter);
  132.   If anIcon<>0 Then
  133.     DrawIcon(hDC, rcItem.left, rcItem.top, anIcon);
  134.   SetBkColor(hDC, OldBkColor);
  135.  
  136.   If itemState And ODS_Focus<>0 Then
  137.     DrawRedFrame(hDC, rcItem) {draw the focus rect}
  138. End End;
  139.  
  140. Procedure tOwnerLBWindow.wmModalClone (Var Msg: tMessage);
  141. Begin
  142.   ExecDialogWindow(New(pOwnerLBWindow, Init(@Self, DialogAttr.Name)))
  143. End;
  144.  
  145. {-------------------- a Control Window for tDialogWindow's properties}
  146. Type
  147.   pControlWindow = ^tControlWindow;
  148.   tControlWindow = Object(tDialogWindow)
  149.     Procedure SetupWindow; Virtual;
  150.     Procedure Ok (Var Msg: tMessage); Virtual id_First+id_Ok;
  151.   End;
  152.  
  153. Const
  154.   Map3D: Array[iCtl3D_Buttons..iCtl3D_StaticFrames] Of Word =
  155.     (Ctl3D_Buttons, Ctl3D_ListBoxes,   Ctl3D_Edits,
  156.      Ctl3D_Combos,  Ctl3D_StaticTexts, Ctl3D_StaticFrames);
  157.  
  158. Procedure tControlWindow.SetupWindow;
  159. Var
  160.   toCheck: Integer;
  161.   pd: pDialogWindow;
  162.   aRect: tRect;
  163. Begin
  164.   Inherited SetupWindow;
  165.   pd:= pDialogWindow(Parent);
  166.   GetWindowRect(pd^.GetItemHandle(iControl), aRect);
  167.   MoveWindow(hWindow, aRect.right, aRect.top, Attr.w, Attr.h, False);
  168.   toCheck:= iUseOrg;
  169.   If pd^.DlgStyle And ForceStd<>0 Then
  170.     toCheck:= iForceStd
  171.   Else If pd^.DlgStyle And ForceBor<>0 Then
  172.     toCheck:= iForceBor;
  173.   CheckRadioButton(hWindow, iUseOrg, iForceBor, toCheck);
  174.   CheckDlgButton(hWindow, iForceGrayBk, Word(pd^.DlgStyle And ForceGrayBk<>0));
  175.   CheckDlgButton(hWindow, iDlgBold,     Word(pd^.DialogAttr.FontWeight=fw_Bold));
  176.   CheckDlgButton(hWindow, iEnableCtl3D, Word(pd^.DlgStyle And EnableCtl3D<>0));
  177.   For toCheck:= Low(Map3D) To High(Map3D) Do
  178.     CheckDlgButton(hWindow, toCheck, Word(pd^.Ctl3DStyle And Map3D[toCheck]<>0))
  179. End;
  180.  
  181. Procedure tControlWindow.Ok (Var Msg: tMessage);
  182. Var
  183.   NewStyle, New3DStyle: LongInt;
  184.   NewFontWeight: Integer;
  185.   pd: pDialogWindow;
  186.   i: Integer;
  187.   Procedure SetLong (Var aLong: LongInt; Bitmask: LongInt; aBool: Boolean);
  188.   Begin
  189.     If aBool Then aLong:= aLong Or Bitmask Else aLong:= aLong And Not Bitmask
  190.   End;
  191. Begin
  192.   pd:= pDialogWindow(Parent);
  193.   NewStyle:= pd^.DlgStyle;
  194.   New3DStyle:= pd^.Ctl3DStyle;
  195.   NewFontWeight:= pd^.DialogAttr.FontWeight;
  196.  
  197.   SetLong(NewStyle, ForceStd, IsDlgButtonChecked(hWindow, iForceStd)=1);
  198.   SetLong(NewStyle, ForceBor, IsDlgButtonChecked(hWindow, iForceBor)=1);
  199.   SetLong(NewStyle, ForceGrayBk, IsDlgButtonChecked(hWindow, iForceGrayBk)=1);
  200.   SetLong(NewStyle, EnableCtl3D, IsDlgButtonChecked(hWindow, iEnableCtl3D)=1);
  201.   If IsDlgButtonChecked(hWindow, iDlgBold)=1 Then
  202.     NewFontWeight:= fw_Bold
  203.   Else
  204.     NewFontWeight:= fw_Normal;
  205.  
  206.   For i:= iCtl3D_Buttons To iCtl3D_StaticFrames Do
  207.     SetLong(New3DStyle, Map3D[i], IsDlgButtonChecked(hWindow, i)=1);
  208.   If (NewStyle<>pd^.DlgStyle) Or (New3DStyle<>pd^.Ctl3DStyle)
  209.   Or (NewFontWeight<>pd^.DialogAttr.FontWeight) Then Begin
  210.     pd^.DlgStyle:= NewStyle;
  211.     pd^.Ctl3DStyle:= New3DStyle;
  212.     pd^.DialogAttr.FontWeight:= NewFontWeight;
  213.     EndDlg(id_Ok)
  214.   End Else
  215.     EndDlg(id_Cancel)
  216. End;
  217.  
  218. {------- a tDialogWindow descendant with scrollers and a property button}
  219. Type
  220.   pJanusWindow = ^tJanusWindow;
  221.   tJanusWindow = Object(tDialogWindow)
  222.     Constructor Init (aParent: pWindowsObject; aName: pChar);
  223.     Procedure Control (Var Msg: tMessage); Virtual id_First+$100;
  224.     Procedure UpdateDialog; Virtual;
  225.   End;
  226.  
  227. Constructor tJanusWindow.Init (aParent: pWindowsObject; aName: pChar);
  228. Begin
  229.   Inherited Init(aParent, aName);
  230.   Attr.Style:= Attr.Style Or ws_VScroll Or ws_HScroll;
  231.   Scroller:= New(pScroller, Init(@Self,1,1,0,0))
  232. End;
  233.  
  234. Procedure tJanusWindow.Control (Var Msg: tMessage);
  235. Var
  236.   Cmd: Integer;
  237. Begin
  238.   If ExecDialogWindow(New(pControlWindow, Init(@Self, pChar(iControlDlg))))=id_Ok Then Begin
  239.     DefStyle:= DlgStyle;
  240.     DefCtl3DStyle:= Ctl3DStyle;
  241.     DefFontWeight:= DialogAttr.FontWeight;
  242.     If Assigned(ModalCode) Then Cmd:= cModal Else Cmd:= cModeless;
  243.     With GlobalPosRect, Attr Do Begin
  244.       left:= X; top:= Y;
  245.       right:= X+w; bottom:= y+h
  246.     End;
  247.     PostMessage(Parent^.hWindow, wm_Command, Cmd, 0);
  248.     If Assigned(ModalCode) Then
  249.       ModalCode^:= id_Cancel
  250.     Else
  251.       PostMessage(hWindow, wm_Close, 0, 0)
  252.   End
  253. End;
  254.  
  255. Procedure tJanusWindow.UpdateDialog;
  256. Begin
  257.   Inherited UpdateDialog;
  258.   {-check for the special case where we want to place our dialog where the previous was}
  259.   With GlobalPosRect, Attr Do
  260.   If left>=0 Then Begin
  261.     x:= left;
  262.     y:= top;
  263.     w:= right-left;
  264.     h:= bottom-top;
  265.     left:= -1
  266.   End
  267. End;
  268.  
  269. {--------------------------- VBX sample window}
  270. Type
  271.   pVbxWindow = ^tVbxWindow;
  272.   tVbxWindow = Object(tDialogWindow)
  273.     Constructor Init (aParent: pWindowsObject; aName: pChar);
  274.   End;
  275.  
  276. Constructor tVbxWindow.Init (aParent: pWindowsObject; aName: pChar);
  277. Var
  278.   aCtl: pVbxControl;
  279. Begin
  280.   Inherited Init(aParent, aName);
  281.   aCtl:= New(pVbxControl, InitResource(@Self, 101));
  282. End;
  283.  
  284. Type
  285.   pAboutWindow = ^tAboutWindow;
  286.   tAboutWindow = Object(tDialogWindow)
  287.     Procedure SetupWindow; Virtual;
  288.   End;
  289.  
  290. Procedure tAboutWindow.SetupWindow;
  291. Var
  292.   i: Integer;
  293. Begin
  294.   Inherited SetupWindow;
  295.   For i:= 10 To 15 Do
  296.     CheckDlgButton(hWindow, i, Word(True))
  297. End;
  298.  
  299. Procedure SelectPrinter (aParent: pWindowsObject);
  300. Var
  301.   aPrinter: pPrinter;
  302. Begin
  303.   aPrinter:= New(pPrinter, Init);
  304.   If Not Assigned(aPrinter) Then
  305.     Exit;
  306.   aPrinter^.Setup(aParent);
  307.   Dispose(aPrinter, Done)
  308. End;
  309.  
  310. Procedure Help;
  311. Var
  312.   FileNameLen: Integer;
  313.   FileName: Array[0..67] Of Char;
  314.   I: integer;
  315. Begin
  316.   FileNameLen:= GetModuleFileName(System.hInstance, FileName, SizeOf(FileName));
  317.   I:= FileNameLen-1;
  318.   While (I<>0) And Not (Filename[I] In ['\',':']) Do
  319.     Dec(I);
  320.   Inc(I);
  321.   If I+13<=SizeOf(FileName) Then
  322.     StrCopy(@FileName[I], 'janusw.hlp')
  323.   Else
  324.     StrCopy(@FileName[I], '?');
  325.   WinHelp(0, FileName, Help_Contents, 0)
  326. End;
  327.  
  328. Const
  329.   Ck: Array[0..1] Of Integer = (mf_ByCommand+mf_UnChecked, mf_ByCommand+mf_Checked);
  330.  
  331. {-all code for the window creation is in the Dispatch function:
  332.   Dispatch is called from tWindow or tMdiWindow depending if this is an
  333.   'normal' or a MDI application
  334. }
  335. Function Dispatch (aParent: pWindow; Var Msg: tMessage): Boolean;
  336. Var
  337.   aWin: pWindow;
  338. Begin
  339.   aWin:= Nil;
  340.   Case Msg.wParam Of
  341.     cAbout: aWin:= New(pAboutWindow,Init (aParent, pChar(iAboutDlg)));
  342.     cHelp:  Help;
  343.     cSwitchMdi: Begin
  344.       AppCtl:= SwitchApp;
  345.       GetWindowRect(aParent^.hWindow, GlobalPosRect);
  346.       PostMessage(Application^.MainWindow^.hWindow,wm_Close,0,0)
  347.     End;
  348.     cSelectPrinter:  SelectPrinter(aParent);
  349.   Else If Hi(Msg.wParam) In [Hi(cModeless), Hi(cModal)] Then
  350.   Case Lo(Msg.wParam) Of
  351.     cJanus:   aWin:= New(pJanusWindow,  Init(aParent, pChar(iJanusDlg)));
  352.     cVbx:     aWin:= New(pVbxWindow, Init(aParent, pChar(iVbxDlg)));
  353.     cUnusual: aWin:= New(pOwnerLBWindow,Init(aParent, pChar(iUnusualDlg)));
  354.   {$IfDef DEW}
  355.     cDEW:     aWin:= New(pCustomer, Init(aParent, 'CUSTOMER'));
  356.   {$EndIf}
  357.   {$IfDef PScc}
  358.     cPscc:    aWin:= New(pPSccWindow,Init(aParent, 'PSccTest')); {PSccTest Dialog}
  359.   {$EndIf}
  360.   {$IfDef Custom}
  361.     cCustTF:  aWin:= New(pCustomWindow, InitTest(aParent, 'ThickFrame',
  362.                           ws_MinimizeBox+ws_MaximizeBox+ws_ThickFrame+ws_Caption+ws_SysMenu, 1, 1));
  363.     cCustCF:  aWin:= New(pCustomWindow, InitTest(aParent, 'Caption',   ws_Caption+ws_SysMenu, 1, 1));
  364.     cCustDF:  aWin:= New(pCustomWindow, InitTest(aParent, 'DlgFrame',  ws_DlgFrame+ws_SysMenu, 1, 1));
  365.     cCustTF2: aWin:= New(pCustomWindow, InitTest(aParent, 'ThickFrame',
  366.                           ws_MinimizeBox+ws_MaximizeBox+ws_ThickFrame+ws_Caption+ws_SysMenu, 5, 8));
  367.     cCustCF2: aWin:= New(pCustomWindow, InitTest(aParent, 'Caption',   ws_Caption+ws_SysMenu, 3, 3));
  368.     cCustDF2: aWin:= New(pCustomWindow, InitTest(aParent, 'DlgFrame',  ws_DlgFrame+ws_SysMenu, 2, 2));
  369.   {$EndIf}
  370.   {$IfDef Test}
  371.     cTest:  aWin:= New(pDialogWindow, Init(aParent, pChar(iControlDlg)));
  372.     cTest2: aWin:= New(pDialogWindow, InitCustom(aParent, pChar(iControlDlg), ForceBor));
  373.   {$EndIf}
  374.   End End;
  375.   If aWin<>Nil Then
  376.     If Hi(Msg.wParam)=Hi(cModeless) Then
  377.       Application^.MakeWindow(aWin)          {modeless}
  378.     Else
  379.       ExecDialogWindow(pDialogWindow(aWin)); {modal}
  380.   Dispatch:= Assigned(aWin)
  381. End;
  382.  
  383. {$IfDef DEW}
  384. Procedure AddDEWEntries (aMenu: hMenu);
  385. Var
  386.   aSubMenu: hMenu;
  387.   i: Integer;
  388. Begin
  389.   For i:= 0 To 0 Do Begin
  390.     aSubMenu:= GetSubMenu(aMenu,i+1);
  391.     AppendMenu(aSubMenu,mf_Separator,0,Nil);
  392.     AppendMenu(aSubMenu,mf_String,cModeless+(i Shl 8)+cDEW,'D&EW demo dialog')
  393.   End
  394. End;
  395. {$EndIf}
  396.  
  397. {$IfDef PScc}
  398. Procedure AddPSccEntries (aMenu: hMenu);
  399. Var
  400.   aSubMenu: hMenu;
  401.   i: Integer;
  402. Begin
  403.   For i:= 0 To 1 Do Begin
  404.     aSubMenu:= GetSubMenu(aMenu,i+1);
  405.     AppendMenu(aSubMenu,mf_Separator,0,Nil);
  406.     AppendMenu(aSubMenu,mf_String,cModeless+(i Shl 8)+cPscc,'PScc')
  407.   End
  408. End;
  409. {$EndIf}
  410.  
  411. {$IfDef Custom}
  412. Procedure AddCustomEntries (aMenu: hMenu);
  413. Var
  414.   aSubMenu: hMenu;
  415.   i: Integer;
  416. Begin
  417.   aSubMenu:= GetSubMenu(aMenu,1);
  418.   AppendMenu(aSubMenu,mf_Separator,0,Nil);
  419.   AppendMenu(aSubMenu,mf_String,cModeless+cCustTF ,'Custom Window (ThickFrame/small)');
  420.   AppendMenu(aSubMenu,mf_String,cModeless+cCustCF ,'Custom Window (Caption/small)');
  421.   AppendMenu(aSubMenu,mf_String,cModeless+cCustDF ,'Custom Window (DlgFrame/small)');
  422.   AppendMenu(aSubMenu,mf_String,cModeless+cCustTF2,'Custom Window (ThickFrame/large)');
  423.   AppendMenu(aSubMenu,mf_String,cModeless+cCustCF2,'Custom Window (Caption/large)');
  424.   AppendMenu(aSubMenu,mf_String,cModeless+cCustDF2,'Custom Window (DlgFrame/large)');
  425. End;
  426. {$EndIf}
  427.  
  428. {$IfDef Test}
  429. Procedure AddTestEntries (aMenu: hMenu);
  430. Var
  431.   aSubMenu: hMenu;
  432.   i: Integer;
  433. Begin
  434.   For i:= 0 To 1 Do Begin
  435.     aSubMenu:= GetSubMenu(aMenu,i+1);
  436.     AppendMenu(aSubMenu,mf_Separator,0,Nil);
  437.     AppendMenu(aSubMenu,mf_String,cModeless+(i Shl 8)+cTest ,'TestDlg (as is)');
  438.     AppendMenu(aSubMenu,mf_String,cModeless+(i Shl 8)+cTest2,'TestDlg (as Bor)')
  439.   End
  440. End;
  441. {$EndIf}
  442.  
  443. Procedure PlaceWindow (aWnd: hWnd);
  444. Var
  445.   aRect: tRect;
  446.   width, height: Integer;
  447. Begin
  448.   GetWindowRect(GetDeskTopWindow, aRect);
  449.   If GlobalPosRect.left>=0 Then With GlobalPosRect Do Begin
  450.     MoveWindow(aWnd, left, top, right-left, bottom-top, False);
  451.     left:= -1
  452.   End Else With aRect Do Begin
  453.     width:= (right-left) Div 4 * 3;
  454.     height:= (bottom-top) Div 4 * 3;
  455.     Inc(left,(right-left) Div 8);
  456.     Inc(top, (bottom-top) Div 8);
  457.     MoveWindow(aWnd,left, top, width, height, False)
  458.   End
  459. End;
  460.  
  461. {-------------------- the MDI part }
  462.  
  463. Type
  464.   paMDIWindow = ^aMdiWindow;
  465.   aMDIWindow = object(tAdvMdiWindow)
  466.     Procedure SetupWindow; Virtual;
  467.     Procedure InitClientWindow; Virtual;
  468.     Procedure DefCommandProc (Var Msg: tMessage); Virtual;
  469.   End;
  470.  
  471. Procedure aMDIWindow.SetupWindow;
  472. Begin
  473.   Inherited SetupWindow;
  474. {$IfDef DEW}    AddDEWEntries(Attr.Menu);    {$EndIf}
  475. {$IfDef PScc}   AddPSccEntries(Attr.Menu);   {$EndIf}
  476. {$IfDef Custom} AddCustomEntries(Attr.Menu); {$EndIf}
  477. {$IfDef Test}   AddTestEntries(Attr.Menu);   {$EndIf}
  478.   CheckMenuItem(Attr.Menu, cMdiAll, Ck[GetWindowLong(ClientWnd^.hWindow, gwl_Style) And MdiS_AllChildStyles]);
  479.   PlaceWindow(hWindow)
  480. End;
  481.  
  482. Procedure aMDIWindow.InitClientWindow;
  483. Begin
  484.  ClientWnd:= New(pMdiClient, Init(@Self));
  485.  With ClientWnd^.Attr do
  486.    Style:= Style Or ws_VScroll Or ws_HScroll Or MdiS_AllChildStyles
  487. End;
  488.  
  489. Procedure aMDIWindow.DefCommandProc (Var Msg: tMessage);
  490. Var
  491.   MdiS: LongInt;
  492. Begin
  493.   If Not Dispatch(@Self, Msg) Then
  494.   Case Msg.wParam Of
  495.     cMdiAll: Begin
  496.             MdiS:= GetWindowLong(ClientWnd^.hWindow,gwl_Style) Xor MdiS_AllChildStyles;
  497.             SetWindowLong(ClientWnd^.hWindow, gwl_Style, MdiS);
  498.             CheckMenuItem(Attr.Menu, cMdiAll, Ck[MdiS And 1])
  499.           End;
  500.   Else
  501.     Inherited DefCommandProc(Msg)
  502.   End
  503. End;
  504.  
  505. {-------------------- the normal window part }
  506.  
  507. Type
  508.   paWindow = ^aWindow;
  509.   aWindow = Object(tWindow)
  510.     Constructor Init (aParent: pWindowsObject; aTitle: pChar);
  511.     Procedure SetupWindow; Virtual;
  512.     Procedure GetWindowClass(var WndClass: TWndClass); virtual;
  513.     Procedure DefCommandProc (Var Msg: tMessage); Virtual;
  514.   End;
  515.  
  516. Constructor aWindow.Init (aParent: pWindowsObject; aTitle: pChar);
  517. Var
  518.   i: Word;
  519. Begin
  520.   Inherited Init(aParent, aTitle);
  521.   Attr.Menu:= LoadMenu(hInstance,pChar(iMainMnu));
  522.   For i:= cm_ArrangeIcons To cm_CloseChildren Do
  523.     EnableMenuItem(Attr.Menu,i,mf_ByCommand+mf_Disabled+mf_Grayed);
  524.   ModifyMenu(Attr.Menu, cSwitchMdi, mf_ByCommand, cSwitchMdi, '&Switch to MDI mode');
  525.   EnableMenuItem(Attr.Menu,cMdiAll,mf_ByCommand+mf_Disabled+mf_Grayed); {MdiS_AllChildStyles}
  526. {$IfDef DEW}    AddDEWEntries(Attr.Menu);    {$EndIf}
  527. {$IfDef PScc}   AddPSccEntries(Attr.Menu);   {$EndIf}
  528. {$IfDef Custom} AddCustomEntries(Attr.Menu); {$EndIf}
  529. {$IfDef Test}   AddTestEntries(Attr.Menu);   {$EndIf}
  530. End;
  531.  
  532. Procedure aWindow.SetupWindow;
  533. Begin
  534.   Inherited SetupWindow;
  535.   PlaceWindow(hWindow)
  536. End;
  537.  
  538. Procedure aWindow.GetWindowClass(var WndClass: TWndClass);
  539. Begin
  540.   Inherited GetWindowClass(WndClass);
  541.   WndClass.lpszMenuName:= Nil
  542. End;
  543.  
  544. Procedure aWindow.DefCommandProc (Var Msg: tMessage);
  545. Begin
  546.   If Not Dispatch(@Self,Msg) Then
  547.     Inherited DefCommandProc(Msg)
  548. End;
  549.  
  550. {-------------------- the Application part }
  551. Type
  552.   tProgApp = Object(tAdvApplication)
  553.     MdiStyle: Boolean;
  554.     Constructor Init (aName: pChar; asMdi: Boolean);
  555.     Destructor Done; Virtual;
  556.     Procedure InitMainWindow; Virtual;
  557.   End;
  558.  
  559. Constructor tProgApp.Init (aName: pChar; asMdi: Boolean);
  560. Begin
  561.   MdiStyle:= asMdi;
  562.   Inherited Init(aName)
  563. End;
  564.  
  565. Destructor tProgApp.Done;
  566. Begin
  567.   If AppCtl=SwitchApp Then
  568.     If MdiStyle Then
  569.       AppCtl:= NormApp
  570.     Else
  571.       AppCtl:= MdiApp
  572.   Else
  573.     AppCtl:= TermApp;
  574.   Inherited Done
  575. End;
  576.  
  577. Procedure tProgApp.InitMainWindow;
  578. Begin
  579.   If MdiStyle Then
  580.     MainWindow:= New(paMDIWindow, Init(ProgName, LoadMenu(hInstance, pChar(iMainMnu))))
  581.   Else
  582.     MainWindow:= New(paWindow, Init(Nil, ProgName));
  583.   hAccTable:= LoadAccelerators(hInstance, pChar(iMainAcc))
  584. End;
  585.  
  586. Var
  587.   App: tProgApp;
  588. Begin
  589.   RegisterVBX(VBXvalidation);
  590.   DefStyle:= OrgStyle;
  591.   With App Do
  592.     Repeat
  593.       Init(ProgName,AppCtl=MdiApp);
  594.       Run;
  595.       Done
  596.     Until AppCtl=TermApp
  597. End.
  598.